perm filename DRAW.F4[CMS,LCS] blob
sn#717261 filedate 1983-06-18 generic text, type T, neo UTF8
C TO DO ****** OD, OS, RS, SZ(SEE SIZE FACTOR)
C***** FOLLOWING IS FILE 'DRAW.CMD' **********
C*** DRAW[DRW,LCS],MSSIO[MS,LCS],DRAWIT[DRW,LCS]
C*** ,DPYIT[DRW,LCS],DREDIT[DRW,LCS],FILLER[DRW,LCS]
C*** ,SUBSLM[DRW,LCS]
C 'G' OR <CR> = GET. 'A'=ADD TO COMBINED FILE.
C P=PLOT
C IN DRAW SECTION: J=JUMP(INVIS. VECT.)
C F=JUMP AND BEGIN FILL SECTION. FX=EXIT AND FILL ALL.
C SINGLE ITEM IS RESTRICTED TO 1000 WDS. 10 ITEMS OR 1000 WDS PER FILE.
C 'O' MAKES CURRENT DPY INTO OVERLAY.
C VECTORS ARE PACKED 1 TO A WORD IN THE FOLLOWING STRANGE MANNER:
C ABCDEFGHI REPRESENTS A 9-DIGIT NUMBER.
C A=0=VISIBLE VECT., A=1=INVISIBLE, A=2=INVIS. AND START OF FILLED AREA.
C A=3=INVIS. AND END FILLED AREA.
C BCDE=THE X COORDINATE, B=0=POSITIVE, B=1=NEG. (THE RANGE IS + OR - 999)
C FGHI=THE Y COORDINATE, F=0=POSITIVE, F=1=NEG. (THE RANGE IS + OR - 999)
C THUS 100671025 MEANS INVIS. VECTOR TO X=67, Y=-25.
COMMON /SAV/JCLEF(10),KCLEF(10),NMLST(10) /INC/INC
CIRC COMMON /RC/MCLEF(400)
COMMON /RC/MCLEF(1000),IST(4000)
1 /GRID/GRID /TL/JXT,JYT
CIRC 1 /DPY/NDP,IOV,GRID
C NDP=BUFFER NUM FOR OUTPUT, IOV=BUFFER NUM FOR INPUT
COMMON /GRD/GRD(1000)
DIMENSION JST(1050),INP(72),V(30),JDP(3)
COMMON/ZN/SCLEF(2,1000),DDD /ED/KED,NEXT,NN,NX,NY,J
COMMON XX(100),G(100),NJ,QF(512),RF(512),S(100),K
COMMON/NFF/NF(513) /LL/LL /RZ/RSZ,RJB,CENTR,XSZ
CIRC COMMON/LETS/LETS(14) /FL/IC,N,NQ,RZ
CIRC DATA LETS/'G','S','M','D','R','P','A','F','E','Z',
CIRC 1'O','L','W','H'/, ISIZE/2000/, RJB/-20./,CENTR/-26./
COMMON/LETS/LETS(15) /FL/IC,N,NQ,RZ
DATA LETS/'G','S','M','D','R','P','A','F','E','Z',
1'O','L','W','H','Q'/, ISIZE/2000/, RJB/0./,CENTR/0./
CCRMA 1'O','L','W','H','Q'/, ISIZE/2000/, RJB/-20./,CENTR/-26./
EQUIVALENCE (MM,SCLEF(1,1)),(V2,V(2)),(V3,V(3)),(N,INP),
1 (IVI,V1,V),(LETS(13),LW),(LETS(14),LH),(JC,INP(2)),(JS,
1 INP(3)),(LETS(1),LG),(LETS(2),LS),(LETS(3),LM),(LETS(4)
1,LD),(LETS(5),LR),(LETS(6),LP),(LETS(7),LA),(LETS(8),LF)
1,(LETS(9),LE),(LETS(10),LZ),(LETS(11),LO),(LETS(12),LLL)
1,(IST2,IST(2))
CIRC CALL ERRSET(0)
CIRC CALL DPYSET(ISIZE,1)
CIRC NDP=1
CIRC IOV=1
RSZ=0
GRID=0
39 MCLEF(1)=0
CIRC CALL DPYCLR
CIRC CALL DPYOUT(NDP)
CALL DPYSET(1,IST,4000)
CALL DPYSET(5,JDP,3)
CALL HYDPOG(1)
JXT=-220
JYT=-480
3939 CALL TYPLOC(JXT,JYT)
C IF AN OVERLAY HAS BEEN SETUP IT SHOULD STILL DISPLAY AFTER DPYCLR.
C THIS IS FOR 'Z' (ZERO THE DRAWING)
C DPYSET INITIALIZES GRAPHICS PACKAGE AND EXPANDS CORE FOR BUFFER.
MM=0
K=1
17 FORMAT(' *',$)
18 FORMAT(' H=HELP')
TYPE 18
91 TYPE 17
CALL DPY
55 FORMAT(I,2F)
50 FORMAT(72A1)
500 QSZ=RSZ
ACCEPT 50,INP
CALL RREAD(INP,V)
C V ARRAY HAS ZEROS IF ALPHAS IN INP ARRAY.
RSZ=V2
GRID=V3
51 IF(RSZ.EQ.0)RSZ=QSZ
C TO SAVE SIZE FACTOR WHEN REDRAWING.
MORE=-1
CALL LO2UP(N)
CALL LO2UP(JC)
CALL LO2UP(JS)
IF(RSZ.EQ.0)RSZ=5.0
C XSZ=RSZ*418./580.
XSZ=RSZ
IF(GRID.NE.0.AND.N.NE.LP)CALL GRIDS
CIRC DO 191 K=1,14
DO 191 K=1,15
C G S M D R P A F E Z
191 IF(LETS(K).EQ.N)GO TO(30,36,32,33,32,70,36,79,38,39,
1 56,11,12,16,32)K
C O L W H Q
IF(N.NE.' ')TYPE 391
GO TO 91
391 FORMAT(' UNKNOWN COMMAND'/)
C 'O' MAKES CURRENT DPY INTO OVERLAY
16 CALL DPYCLR
CALL TYPLOC(320,-320)
TYPE 100
C 'HELP'
TYPE 101
ACCEPT 50,INP
CALL TYPLOC(JXT,JYT)
CALL DP(1)
CC CALL DPYOUT(1)
GO TO 91
11 CALL LIST(0)
C TYPE OUT LIST OF COORDINATES.
GO TO 91
12 TYPE 41
C WRITE LIST OF COORDS ON DISK FILE
CALL A5IN(JC)
IF(N.NE.LW)GO TO 13
CALL LIST(JC)
GO TO 91
13 CALL READIN(JC,JS,JZ)
GO TO 334
CIRC56 CALL DPYSET(400,2)
CCRMA56 CALL POG2
C INITIALIZE THE OVERLAY
CIRC IOV=2
CIRC NDP=2
CIRC CALL RDRAW(2,MCLEF(1),MCLEF)
56 IF(JC.NE.LD)GO TO 256
CALL HYDPOG(3)
GO TO 91
C O=OVERLAY, OD=OVERLAY DISAPPEARS, OS=SEE OVERLAY
256 IF(JC.NE.LS)GO TO 156
257 CALL DPYOUT(3)
GO TO 91
156 CALL DPYSET(3,GRD,400)
CALL RDRAW(3,2,MCLEF(1),MCLEF)
CALL DPYOUT(3)
CIRC IOV=1
CIRC CALL DPYOUT(NDP)
C SAVE OVERLAY IN SPECIAL MEMORY
GO TO 91
36 IF(JC.NE.LZ)GO TO 136
C SZ=SHOW CURRENT SIZE FACTOR
K=RSZ
TYPE 55,K
GO TO 91
136 CALL CMBN
GO TO 91
32 IF(JC.EQ.LS)GO TO 39
IF(JC.EQ.LE)GO TO 12
C RE=READ EDIT FILE FOR VECTORS, RS=RESTART (SAME AS Z)
CALL DPSET
CALL SHIFT(MCLEF(2),MCLEF(1),N)
C FOR ROTATION OR MOVING AND DISTORTING ENTIRE PICTURE
J=1
JC=0
GO TO 333
291 FORMAT(A2,A5)
30 IF(JC.NE.'R')GO TO 300
GRID=1
CALL GRIDS
C 'GR'=DRAW GRID
GO TO 91
300 REREAD 291,NM,NM
CALL LO2UP(NM)
IF(JC.EQ.LM)NM=' '
IF(NM.NE.' ')GO TO 293
130 TYPE 41
IF(JC.EQ.LM)GO TO 194
IF(N.EQ.LS)GO TO 194
C 'GET' REINIT VARIOUS THINGS
MCLEF(1)=0
MM=0
K=1
194 IF(JC.EQ.LM)MORE=0
JQ=JC
JC=0
JM=1
IF(MCLEF(1).EQ.0)GO TO 193
JM=MCLEF(1)+1
193 CALL A5IN(NM)
IF(NM.EQ.' ')NM=LASTNM
IF(NM.EQ.' ')GO TO 91
IF(NM.EQ.'B'.OR.NM.EQ.'99')GO TO 91
C 'B' OR '99' WILL BACKUP
293 LASTNM=NM
IF(LOOKF(NM).EQ.0)GO TO 130
C 'FAIL' ROUTINE TO CHECK ON LOOKUP 0=FILE NOT FOUND.
CALL RDSAV(KCLEF,NMLST,M,NM,JST,-1)
C -1=READ
J=1
IF(KCLEF(2).EQ.0)GO TO 290
TYPE 1100
ACCEPT 55,J
J=J+1
C ITEMS ARE NUMBERED 0 THROUGH 9 (10 ITEMS).
IF(J.GT.10)GO TO 191
290 IC=KCLEF(J)+JST(KCLEF(J))-1
IF(IC.GT.1000)TYPE 1110
60 JZ=1
IF(MORE.EQ.0)JZ=JM
L=KCLEF(J)-1
M=JST(L+1)+JZ-1
IF(MORE.NE.0)GO TO 161
M=M-1
L=L+1
161 DO 61 K=JZ,M
L=L+1
61 MCLEF(K)=JST(L)
MCLEF(1)=M
1100 FORMAT(' ITEM NUM?'/)
7 IF(MORE.LT.0)GO TO 70
CX DO 771 K=2,JM-1
CX771 IF(MCLEF(K).GE.200000000)GO TO 772
CX GO TO 70
772 IF(MCLEF(JZ).LT.200000000)MCLEF(JZ)=MCLEF(JZ)+200000000
C STOP FILLER ON FIRST POINT WITH 'GM' (UNLESS TO BE FILLED)
70 IF(N.NE.LP)GO TO 3
CIRC OPEN(UNIT=1,FILE='PLOT.PLT',MODE='IMAGE')
CIRC CALL SAVBUF(1)
C WRITES VERSATEC FILE PLOT.PLT
CIRC CLOSE(UNIT=1)
CIRC TYPE 441
CIRC GO TO 91
CIRC441 FORMAT(' ******* PLOT.PLT WAS WRITTEN *****')
3 IF(N.NE.LD)MM=0
C RESET IF NOT GOING TO DRAWIT
333 IF(N.EQ.LP)GO TO 337
CC CALL DPYCLR
IF(N.GE.0)GO TO 337
IF(N.EQ.LG)GO TO 337
IF(N.EQ.LM)GO TO 337
IF(N.NE.LR)GO TO 92
337 IF(JS.EQ.LZ)GO TO 306
IF(JS.NE.LS)GO TO 338
CALL SMOOTH(JS)
CCRMA GO TO 436
GO TO 91
338 IC=-1
MM=1
DO 335 K=2,MCLEF(1)
IF(MCLEF(K).LT.200000000)GO TO 335
IC=K
GO TO 334
C FOR 1ST LOC. OF MCLEF IN FILLER
335 CONTINUE
CIRC334 CALL RDRAW(2,MCLEF(1),MCLEF)
334 CALL RDRAW(1,2,MCLEF(1),MCLEF)
C 1=DPYOUT(1)
CIRC CALL DPYOUT(NDP)
GO TO 91
79 IF(IC.LT.0)GO TO 91
C FILLS IT.
C IC=-1 IF NO FILLER WAS REQUESTED WHILE DRAWING.
JZ=N
KK=0
IF(JC.NE.LS)GO TO 206
C TYPE 'FS' TO FILL AND SMOOTH
306 CALL SMOOTH(0)
C SMOOTHS AND FILLS
CCRMA GO TO 436
GO TO 91
C206 RR=RSZ
206 IFIL=0
C 0=CONINUOUS LINE, 1=JUMP, 2=JUMP, START FILL, 3=JUMP, END FILL
DO 205 J=IC,MCLEF(1)
CALL UNPACK(M,N,LL,MCLEF(J))
IF(LL.EQ.200000000)IFIL=-1
C START FILL
IF(LL.EQ.300000000)IFIL=0
C END FILL
IF(IFIL.EQ.0)GO TO 205
KK=KK+1
NF(KK)=0
IF(LL.GE.100000000)NF(KK)=3
C PUT ONLY "FILL" VECTORS INTO QF AND RF ARRAYS
QF(KK)=(M+RJB)*XSZ
RF(KK)=(N+CENTR)*RSZ
205 CONTINUE
NF(1)=KK
CALL FILLQ(QF,RF,NF)
436 GO TO 91
100 FORMAT(' G=GET, GM=GET MORE, S=SAVE, D=DRAW, M=MOVE, R=ROTATE,'/
1' E=EDIT, P=PLOT, RE=READ EDIT FILE, W=WRITE EDIT FILE'/
1' GR=MAKE GRID, LI=LIST COORDINATES, Q=REPEAT LAST MOVE'/
1,' REN=RENAME ITEM IN LIBRARY, O=OVERLAY'/
1,' OD=MAKE OVERLAY DISAPPEAR, OS=SEE OVERLAY'/
1,' DEL=DELETE ITEM FROM FILE, Z=ZERO DRAWING'/,
1' F=FILL N1=IMAGE SIZE, N2=1=GRID -1=DELETE OVERLAY'/)
101 FORMAT(' **** IN DRAW MODE ****'/
1,' B=BACKUP, RE=RELATIVE VECTORS, AB=ABSOLUTE VECTORS'/
1,' C=CLOSE THE AREA 0,0 IS CENTER OF SCREEN'/
1,' AFTER X,Y COORDS YOU MAY ENTER 1, 2, OR 3.'/
1,' 1=JUMP (INVISIBLE VECTOR), 2=JUMP AND START FILL'/
1,' 3=JUMP AND STOP FILL.'/
1,' THE FOLLOWING MOVE THE LAST ENTERED POINT:'/
1,' LN=MOVE LEFT N STEPS RN=MOVE RIGHT N STEPS'/
1,' UN=UP N STEPS DN=DOWN N STEPS (N IS "STICKY")'//
1,' **** IN EDIT MODE ****'/
1,' B=BACKUP, A=ALTER, I=INSERT, M N1 N2=MOVE POINTS N1-N2'/
1,' J=JUMP TO END OF NEXT INVISIBLE VECTOR'/
1,' IN ALTER OR INSERT MODE:'/
1,' J=JUMP, F=JUMP AND START FILL, C=CONTINUE(ERASE JUMP)'/
1,' S=JUMP AND STOP FILL, N=NO, Y=YES, B=BACKUP'//
1,' TYPE <CR> TO CONTINUE.'/)
C N1=20 TO CHANGE SHAPE
33 IF(JS.NE.LLL)GO TO 38
N=LZ
C DEL=DELETE FROM COMB. FILE. (JS=LLL)
GO TO 36
38 KED=N
MM=MCLEF(1)
CX IF(MM.NE.0)GO TO 92
C ADD TO DRAWING?
CIRC92 CALL DPYCLR
C92 CALL HYDPOG(1)
92 CALL DPSET
CIRC CALL RDRAW(2,MCLEF(1),MCLEF)
CALL RDRAW(1,2,MCLEF(1),MCLEF)
C THIS CLEARS FILLER LINES
CALL DRAWIT
N=0
GO TO 3
403 FORMAT(' WRITE OVER ',A5,'.DMD? ',$)
41 FORMAT(' TYPE FILE NAME'/)
110 FORMAT(' TOTAL WDS=',I3)
1110 FORMAT(' ********************************',/
1 ' ***** WARNING - LIMIT=1000 ******',/
1 ' ********************************')
END
SUBROUTINE DPY
COMMON /RC/MCLEF(1000),IST1,IST2
CCC COMMON /DP/ISET /RC/MCLEF(400),IST1,IST2
CALL SETPOG(1)
CALL DP(1)
CC ISET=IST2
C SAVE DPY WDCNT
END
SUBROUTINE DPSET
COMMON /RC/MCLEF(1000),IST(4000) /TL/JXT,JYT
CALL DPYSET(1,IST,4000)
CALL TYPLOC(JXT,JYT)
END
SUBROUTINE SETCUR(J,K,L)
C COMMON /DP/ISET /RC/MCLEF(400),IST1,IST2
DIMENSION I(50)
DATA LIM/490/
CALL DPYSET(4,I,50)
CALL HYDPOG(4)
ISET=IST2
JQ=J
KQ=K
IF(JQ.GT.LIM)JQ=LIM
IF(JQ.LT.-LIM)JQ=-LIM
IF(KQ.GT.LIM)KQ=LIM
IF(KQ.LT.-LIM)KQ=-LIM
JA=JQ-20
JB=JQ+20
KA=KQ-20
KB=KQ+20
C CALL AIVECT(JA,KA)
C CALL AVECT(JB,KB)
C CALL AIVECT(JA,KB)
C CALL AVECT(JB,KA)
CALL ALINE(JA,KA,JB,KB)
CALL ALINE(JA,KB,JB,KA)
CC CALL DPYOUT(4)
CALL DP(4)
END
SUBROUTINE DP(J)
CALL DPYOUT(J)
CC CALL DPYOUT(5)
C SO TYPE OUT WILL APPEAR
DO 1 K=1,50
1 CONTINUE
END
SUBROUTINE READIN(JC,JS,JZ)
COMMON /RC/MCLEF(1000),IST(4000) /FL/IC,N
CIRC13 OPEN(UNIT=1,FILE=JC)
13 CALL IFILE (1,JC)
14 READ(1,5,END=15)N,JC,JS,JZ
5 FORMAT(12I)
C READ IN EDIT FILE OF COORDS. N, X, Y, Z (N IS COUNT NUMB.)
JZ=JZ*100000000
C JZ=1=INVIS =2=START FILLER (INVIS)
CALL REPACK(JC,JS,JZ,MCLEF(N+1))
GO TO 14
15 MCLEF(1)=N+1
CIRC CALL DPYCLR
CALL DPSET
END
SUBROUTINE CLRCUR
CALL HYDPOG(4)
END
SUBROUTINE RDCUR
END